home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / rectangles.mod (.txt) < prev    next >
Oberon Text  |  1990-01-01  |  5KB  |  127 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Rectangles;  (*NW 25.2.90 / 1.2.92*)
  3.     IMPORT Display, Files, Input, Printer, Texts, Oberon, Graphics, GraphicFrames;
  4.     TYPE
  5.         Rectangle* = POINTER TO RectDesc;
  6.         RectDesc* = RECORD (Graphics.ObjectDesc)
  7.                 lw*, vers*: INTEGER
  8.             END ;
  9.     VAR 
  10.         method*: Graphics.Method;
  11.         shade: INTEGER;
  12.     PROCEDURE New*;
  13.         VAR r: Rectangle;
  14.     BEGIN NEW(r); r.do := method; Graphics.new := r
  15.     END New;
  16.     PROCEDURE Copy(src, dst: Graphics.Object);
  17.     BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col;
  18.         dst(Rectangle).lw := src(Rectangle).lw; dst(Rectangle).vers := src(Rectangle).vers
  19.     END Copy;
  20.     PROCEDURE mark(f: GraphicFrames.Frame; col, x, y: INTEGER);
  21.     BEGIN Display.ReplConstC(f, col, x-4, y, 4, 4, 0)
  22.     END mark;
  23.     PROCEDURE Draw(obj: Graphics.Object; VAR M: Graphics.Msg);
  24.         VAR x, y, w, h, lw, col: INTEGER; f: GraphicFrames.Frame;
  25.         PROCEDURE draw(col: INTEGER);
  26.         BEGIN
  27.             Display.ReplConstC(f, col, x, y, w, lw, 0);
  28.             Display.ReplConstC(f, col, x+w-lw, y, lw, h, 0);
  29.             Display.ReplConstC(f, col, x, y+h-lw, w, lw, 0);
  30.             Display.ReplConstC(f, col, x, y, lw, h, 0)
  31.         END draw;
  32.     BEGIN
  33.         WITH M: GraphicFrames.DrawMsg DO
  34.             x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
  35.             lw := obj(Rectangle).lw;
  36.             IF (x < f.X1) & (x+w > f.X) & (y < f.Y1) & (y+h > f.Y) THEN
  37.                 IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ;
  38.                 IF M.mode = 0 THEN
  39.                     draw(col);
  40.                     IF obj.selected THEN mark(f, Display.white, x+w-lw, y+lw) END ;
  41.                     IF obj(Rectangle).vers # 0 THEN Display.ReplPatternC(f, col, Display.grey0, x, y, w, h, x, y, 1) END
  42.                 ELSIF M.mode = 1 THEN mark(f, Display.white, x+w-lw, y+lw)
  43.                 ELSIF M.mode = 2 THEN mark(f, Display.black, x+w-lw, y+lw)
  44.                 ELSIF obj(Rectangle).vers = 0 THEN draw(f.col); mark(f, f.col, x+w-lw, y+lw)
  45.                 ELSE Display.ReplConstC(f, f.col, x, y, w, h, 0)
  46.                 END
  47.             END
  48.         END
  49.     END Draw;
  50.     PROCEDURE Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
  51.     BEGIN
  52.         RETURN (obj.x + obj.w - 4 <= x) & (x <= obj.x + obj.w) & (obj.y <= y) & (y <= obj.y + 4)
  53.     END Selectable;
  54.     PROCEDURE Handle(obj: Graphics.Object; VAR M: Graphics.Msg);
  55.         VAR x0, y0, x1, y1, dx, dy: INTEGER; k: SET;
  56.     BEGIN
  57.         IF M IS Graphics.WidMsg THEN obj(Rectangle).lw := M(Graphics.WidMsg).w
  58.         ELSIF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col
  59.         ELSIF M IS GraphicFrames.CtrlMsg THEN
  60.             WITH M: GraphicFrames.CtrlMsg DO
  61.                 WITH obj: Rectangle DO
  62.                     M.res := 1; x0 := obj.x + obj.w + M.f.x; y0 := obj.y + M.f.y;
  63.                     mark(M.f, Display.white, x0 - obj.lw, y0 + obj.lw);
  64.                     REPEAT Input.Mouse(k, x1, y1);
  65.                         DEC(x1, (x1-M.f.x) MOD 4); DEC(y1, (y1-M.f.y) MOD 4);
  66.                         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x1, y1)
  67.                     UNTIL k = {};
  68.                     mark(M.f, Display.black, x0 - obj.lw, y0 + obj.lw);
  69.                     IF (x0 - obj.w < x1) & (y1 < y0+ obj.h) THEN
  70.                         GraphicFrames.EraseObj(M.f, obj);
  71.                         dx := x1 - x0; dy := y1 - y0;
  72.                         INC(obj.y, dy); INC(obj.w, dx); DEC(obj.h, dy);
  73.                         GraphicFrames.DrawObj(M.f, obj)
  74.                     END
  75.                 END
  76.             END
  77.         END
  78.     END Handle;
  79.     PROCEDURE Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context);
  80.         VAR w, v: SHORTINT; len: INTEGER;
  81.     BEGIN Files.ReadInt(R, len); Files.Read(R, w); Files.Read(R, v);
  82.         obj(Rectangle).lw := w; obj(Rectangle).vers := v
  83.     END Read;
  84.     PROCEDURE Write(obj: Graphics.Object; cno: SHORTINT; VAR W: Files.Rider; VAR C: Graphics.Context);
  85.     BEGIN Graphics.WriteObj(W, cno, obj); Files.WriteInt(W, 2);
  86.         Files.Write(W, SHORT(obj(Rectangle).lw)); Files.Write(W, SHORT(obj(Rectangle).vers))
  87.     END Write;
  88.     PROCEDURE Print(obj: Graphics.Object; x, y: INTEGER);
  89.         VAR w, h, lw, s: INTEGER;
  90.     BEGIN INC(x, obj.x * 4); INC(y, obj.y * 4); w := obj.w * 4; h := obj.h * 4;
  91.         lw := obj(Rectangle).lw * 2; s := obj(Rectangle).vers;
  92.         Printer.ReplConst(x, y, w, lw);
  93.         Printer.ReplConst(x+w-lw, y, lw, h);
  94.         Printer.ReplConst(x, y+h-lw, w, lw);
  95.         Printer.ReplConst(x, y, lw, h);
  96.         IF s > 0 THEN Printer.ReplPattern(x, y, w, h, s) END
  97.     END Print;
  98.     PROCEDURE Make*;  (*command*)
  99.         VAR x0, x1, y0, y1: INTEGER;
  100.             R: Rectangle;
  101.             G: GraphicFrames.Frame;
  102.     BEGIN G := GraphicFrames.Focus();
  103.         IF (G # NIL) & (G.mark.next # NIL) THEN
  104.             GraphicFrames.Deselect(G);
  105.             x0 := G.mark.x; y0 := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y;
  106.             NEW(R); R.col := Oberon.CurCol;
  107.             R.w := ABS(x1-x0); R.h := ABS(y1-y0);
  108.             IF x1 < x0 THEN x0 := x1 END ;
  109.             IF y1 < y0 THEN y0 := y1 END ;
  110.             R.x := x0 - G.x; R.y := y0 - G.y;
  111.             R.lw := Graphics.width; R.vers := shade; R.do := method;
  112.             Graphics.Add(G.graph, R);
  113.             GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, R)
  114.         END
  115.     END Make;
  116.     PROCEDURE SetShade*;
  117.         VAR S: Texts.Scanner;
  118.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  119.         IF S.class = Texts.Int THEN shade := SHORT(S.i) END
  120.     END SetShade;
  121. BEGIN shade := 0; NEW(method);
  122.     method.module := "Rectangles"; method.allocator := "New";
  123.     method.new := New; method.copy := Copy; method.draw := Draw;
  124.     method.selectable := Selectable; method.handle := Handle;
  125.     method.read := Read; method.write := Write; method.print := Print
  126. END Rectangles.
  127.